perm filename PP.LSP[RUT,LSP] blob sn#343762 filedate 1978-03-22 generic text, type T, neo UTF8
(DECLARE (SPECIAL PP PRETTYPROPS NOPRETTYPROPS PRETTYFLG COMMENTFLG COMMENTSTR
		  PPMAXLEN %%LL %%BR %%CC %%T %%LP %%RP LASTWORD EDITV INTERNSTR
	  )
	 (NOCALL %SPRINT %DEPTH %PPSIZE %PPSPEC %%LL %%BR %%CC %%T %%LP %%RP))

(DEFP ; NILL FSUBR)

(DEFP ;; NILL FSUBR)

(DRM /{ /{)

(DEFPROP /{
 (LAMBDA NIL
  (PROG (CH COM FLG INTERNSTR)
	(SETQ COM (TCONC NIL 40.))
   LOOP (COND [(OR [EQ (SETQ CH (TYI)) 32.] [AND [*LESS CH 14.] [*GREAT CH 8.]])
	       (SETQ FLG T)
	       (GO LOOP)]
	      [(NEQ CH 125.)
	       (COND [FLG (TCONC COM 32.) (SETQ FLG NIL)])
	       (TCONC COM (COND [(EQ CH 34.) 39.] [T CH]))
	       (GO LOOP)]
	      [(SETQ CH (MEMB 32. (CAR COM)))
	       (RPLACD CH (CONS 34. (CDR CH)))
	       (TCONC COM 34.)])
	(TCONC COM 41.)
	(RETURN (PROG1 (READLIST (CAR COM)) (FREELIST (CAR COM)) (FREE COM)))))
 EXPR)

{;; (This comment has to follow the above definition).  If your READLIST doesn't
    allow ASCII values, the above readmacro and PP-COMMENT will have to be
    modified.⎇

{;; Top level functions:⎇

(DEFPROP PPL
 (LAMBDA (%L)
  {;; Replaces GRINL.  Outputs binding for function list unless already dumped
      or atom was ALLFNS or ALLVALS.⎇
  (PROG (LASTWORD EDITV) 	       {; Don't change LASTWORD or EDITV⎇
	(MAPC (FUNCTION
	       (LAMBDA (%A)
		(COND [(AND [LITATOM %A] [SETQ %L (EVAL %A)])
		       (APPLY# 'PP %L)
		       (AND [NEQ %A 'ALLFNS]
			    [NEQ %A 'ALLVALS]
			    [NOT (MEMB %A %L)]
			    [APPLY# 'MBD: (LIST 'NOCOMPILE (LIST 'V: %A))])])))
	      %L)
	(RETURN (IASCII 0.))))
 FEXPR)

(DEFPROP PPL;
 (LAMBDA (%L)
  (PROG (COMMENTFLG) (SETQ COMMENTFLG T) (RETURN (APPLY# 'PPL %L))))
 FEXPR)

(DEFPROP PP
 (LAMBDA (%L)
  {;; Replaces GRINDEF.  Evaluates PPCOM commands - SPRINTs other lists (except
      LAP code which is printed as such).  Notifies user of any atoms with no
      props on PRETTYPROPS.⎇
  (PROG (%FLAG %D %CH)
	(SETQ %CH (OUTCH))
	(MAPC
	 (FUNCTION
	  (LAMBDA (%A)
	   (COND
	    [(CONSP %A)
	     (COND [(AND [CONSP (CAR %A)] [EQ (CAAR %A) 'LAP])
		    (TERPRI)
		    (PRIN1 (CAR %A))
		    (MAPC (FUNCTION
			   (LAMBDA (X)
			    (TAB (COND [(AND X [ATOM X]) 2.] [T 9.]))
			    (SETQ %A (PRIN1 X))))
			  (CDR %A))
		    (COND [%A (TAB 9.) (PRIN1 NIL)])
		    (TERPRI)]
		   [(AND [LITATOM (CAR %A)] [GET (CAR %A) 'PPCOM]) (EVAL %A)]
		   [T (TERPRI) (SPRINT %A 1.) (TERPRI)])]
	    [(LITATOM %A)
	     (COND [(GETL %A '(BROKEN-IN NAMESCHANGED))
		    (UNBREAK! %A)
		    (SETQ %L NIL)]
		   [T (SETQ %L (GET %A 'TRACE))])
	     (SETQ %FLAG NIL)
	     (MAPC
	      (FUNCTION
	       (LAMBDA (%P)
		(PROG (%SP)
		      (COND [(CONSP %P) (SETQ %SP (CDR %P)) (SETQ %P (CAR %P))])
		      (COND
		       [(MEMB %P '(EXPR FEXPR MACRO))
			(COND
			 [(AND [SETQ %D (GET %A %P)]
			       [OR [NULL %L]
				   [SETQ %D
					 (GET (CDR %L)
					      (COND [(EQ %P 'MACRO) 'FEXPR]
						    [T %P]))]])
			  (AND [NULL %CH] [SETQ LASTWORD %A])]
			 [T (RETURN NIL)])]
		       [(EQ %P 'VALUE)
			(COND [(AND [SETQ %D (GET %A %P)]
				    [NEQ (CDR %D) (UNBOUND)])
			       (AND [NULL %CH] [SETQ EDITV %A])
			       (UNMACEXPAND (CDR %D))
			       (GO SKIP)]
			      [T (RETURN NIL)])]
		       [(NULL (SETQ %D (GET %A %P))) (RETURN NIL)])
		      (UNMACEXPAND %D) {; Get rid of any macro expansions⎇
		 SKIP (SETQ %FLAG T)
		      (TERPRI)
		      (COND [%SP (%SP %A %D %P)]
			    [T (SPRINT (LIST 'DEFPROP %A %D %P) 1.)])
		      (TERPRI))))
	      PRETTYPROPS)
	     (COND [(AND PP %CH %FLAG)
		    (OUTC NIL NIL)
		    (MSG %A 1.)
		    (OUTC %CH NIL)]
		   [(AND [NULL %FLAG] NOPRETTYPROPS)
		    (TTYMSG -1. %A " has no properties on PRETTYPROPS." T)])]
	    [T (MSG T %A T)])))
	 (OR %L [LIST LASTWORD]))
	(RETURN (IASCII 0.))))
 FEXPR)

(DEFV PP NIL)

(DEFV NOPRETTYPROPS T)

(DEFPROP PP;
 (LAMBDA (%L)
  (PROG (COMMENTFLG) (SETQ COMMENTFLG T) (RETURN (APPLY# 'PP %L))))
 FEXPR)

{;; PPCOM command functions:⎇

(DEFPROP *PG* (LAMBDA NIL (TYO 12.) NIL) EXPR)

(DEFPROP F:
 (LAMBDA (L)
  (PROG (PRETTYPROPS)
	(SETQ PRETTYPROPS '(EXPR FEXPR MACRO))
	(RETURN (AND L [APPLY# 'PP L]))))
 FEXPR)

(DEFPROP P:
 (LAMBDA (L)
  (PROG (PRETTYPROPS)
	(SETQ PRETTYPROPS (CAR L))
	(RETURN (AND [CDR L] [APPLY# 'PP (CDR L)]))))
 FEXPR)

(DEFPROP V:
 (LAMBDA (L)
  (MAPC (FUNCTION
	 (LAMBDA (X)
	  (PROG (V)
		(COND [(LITATOM X)
		       (SETQ V (GET X 'VALUE))
		       (AND [EQ (CDR V) (UNBOUND)] [SETQ V '(NIL)])]
		      [(AND [CONSP X] [LITATOM (CAR X)])
		       (SETQ V (CONS NIL (CADR X)))
		       (SETQ X (CAR X))]
		      [T (RETURN (MSG T X T))])
		(UNMACEXPAND (CDR V))  {; Just in case the value of this
					  variable is ever EVALed⎇
		(TERPRI)
		(PP-VALUE X V 'VALUE)
		(TERPRI)
		(AND PP [OUTCH] [TTYOUT (MSG X 1.)]))))
	L)
  (IASCII 0.))
 FEXPR)

(DEFPROP MBD:
 (LAMBDA (L)
  (COND [(CDR L)
	 (MSG T "(" (CAR L))
	 (APPLY# 'PP (CDR L))
	 (MSG ")" T)
	 (IASCII 0.)]))
 FEXPR)

(DEFPROP FORMS:
 (LAMBDA (L)
  (MAPC (FUNCTION (LAMBDA (X) (TERPRI) (SPRINT X 1.) (TERPRI))) L)
  (IASCII 0.))
 FEXPR)

(DEFP E: PROGN FSUBR)

(DEFLIST (*PG* F: P: V: MBD: FORMS: E:) T PPCOM)

{;; SPRINT and friends:⎇

(DEFPROP SPRINT
 (LAMBDA (%E %C)
  {;; SPRINT now does a quick dump if PRETTYFLG=NIL⎇
  (SETQ %%LL (LINELENGTH NIL)) 	       {; Just retrieve this once!⎇
  (TAB (OR %C 1.))
  (COND [(OR [NULL PRETTYFLG] [PATOM %E]) (PRIN1 %E)]
	[T (%SPRINT %E NIL)])
  NIL)
 EXPR)

(DEFPROP %SPRINT
 (LAMBDA (%E %BR)
  {;; Prettyprints the (non-atomic) structure %E using parentheses if %BR=NIL
      and brackets if %BR=T.  Checks for printmacros and lists of atoms (printed
      as blocks).⎇
  (PROG (%C %CE)
	(COND [%BR (SETQ %%LP 91.) (SETQ %BR (SETQ %%RP 93.))]
	      [T (SETQ %%LP 40.) (SETQ %BR (SETQ %%RP 41.))])
  START (SETQ %C (ADD1 (CHRPOS)))
	(COND [(CONSP (SETQ %CE (CAR %E)))
	       (TYO %%LP)
	       (%SPRINT %CE NIL)
	       (SETQ %%BR NIL)
	       (GO REST)]
	      [(AND [LITATOM %CE] [SETQ %%T (GET %CE 'PRINTMACRO)])
	       (COND [(STRINGP %%T)
		      (AND [OR [PATOM (CDR %E)] [CDDR %E]] [GO OK])
		      (PRINC %%T)
		      (COND [(PATOM (SETQ %E (CADR %E))) (RETURN (PRIN1 %E))]
			    [T (GO START)])]
		     [(EQ %%T 'BRACKETS) (SETQ %%BR T) (GO OK1)]
		     [(NEQ (%%T %E) 'SPRINT) (RETURN NIL)])])
     OK (SETQ %%BR NIL)
    OK1 (TYO %%LP)
	(PRIN1 %CE)
   REST (COND [(PATOM (SETQ %E (CDR %E))) (PP-LSEG %E %C %C %%BR)]
	      [(MINUSP (%PPSIZE %CE (*MIN (*DIF %%LL %C) 50.) T))
	       (PP-LSEG %E %C %C %%BR)]
	      [(NOT (MINUSP (%PPSIZE %E (*MIN (SETQ %%CC (CHRCT)) PPMAXLEN) NIL)
		     ))
	       (PP-LSEG %E NIL NIL %%BR)]
	      [(AND [PATOM %CE]
		    [PROG (%E1)
			  (SETQ %E1 %E)
			A (COND [(CONSP (CAR %E1)) (RETURN NIL)]
				[(PATOM (SETQ %E1 (CDR %E1))) (RETURN T)]
				[T (GO A)])])
	       (PP-LSEG %E NIL (ADD1 (CHRPOS)) %%BR)]
	      [(OR [*GREAT (SETQ %%T (*DIF (CHRPOS) %C)) 12.]
		   [CONSP %CE]
		   [AND [*GREAT %%T 1.] [*GREAT (*TIMES 6. (%DEPTH %E)) %%CC]])
	       (PP-LSEG %E %C %C %%BR)]
	      [T (TYO 32.) (PP-LSEG %E (SETQ %CE (CHRPOS)) %CE %%BR)])
	(TYOA %BR %C)))
 EXPR)

(DEFV PPMAXLEN 65.)

(DEFPROP %DEPTH
 (LAMBDA (%S)
  {;; Returns the maximum nesting depth of the list structure %S⎇
  (PROG (%N)
	(SETQ %N 1.)
   LOOP (AND [CONSP (CAR %S)] [SETQ %N (*MAX %N (ADD1 (%DEPTH (CAR %S))))])
	(COND [(CONSP (SETQ %S (CDR %S))) (GO LOOP)] [T (RETURN %N)])))
 EXPR)

(DEFPROP %PPSIZE
 (LAMBDA (%E %N %F)
  {;; Checks to see if %E can be SPRINTed in %N spaces.  Returns negative number
      if it can't, and number of spaces left over if it can.  %F is T if %E is a
      real expression (a check is then made for a printmacro string).  If %F is
      NIL %E is a segment (no top-level check for printmacro).⎇
  (PROG NIL
  START (COND [(PATOM %E) (RETURN (*DIF %N (FLATSIZE %E)))]
	      [(AND %F [LITATOM (CAR %E)] [SETQ %F (GET (CAR %E) 'PRINTMACRO)])
	       (COND [(AND [STRINGP %F] [CONSP (CDR %E)] [NULL (CDDR %E)])
		      (SETQ %N (*DIF %N (FLATSIZEC %F)))
		      (SETQ %E (CADR %E))
		      (GO START)]
		     [(SETQ %F (GET (CAR %E) 'COMMENT))
		      (AND [NULL (OUTCH)]
			   [NULL COMMENTFLG]
			   [RETURN (*DIF %N 9.)])
		      (AND [NUMBERP %F] [RETURN -1.])])])
	(SETQ %N (SUB1 (*DIF %N (LENGTH %E))))
   LOOP (COND [(MINUSP %N) (RETURN %N)] [T (SETQ %N (%PPSIZE (CAR %E) %N T))])
	(COND [(CONSP (SETQ %E (CDR %E))) (GO LOOP)]
	      [(NULL %E) (RETURN %N)]
	      [T (RETURN (DIFFERENCE %N (FLATSIZE %E) 3.))])))
 EXPR)

(DEFPROP PP-LSEG
 (LAMBDA (%L %C1 %C2 %BR)
  {;; Prints the list-segment %L.  %C1 gives column to print lists in.  %C2
      gives column to print atoms in (if %C2 is NIL atoms are automatically
      outdented).  If %C1 is NIL the elements are printed as a block (%C2 then
      gives the column to resume printing if an element won't fit on the line). 
      %BR is the bracket flag to pass to %SPRINT.⎇
  (PROG NIL
   LOOP (AND [PATOM %L] [GO DONE])
  LOOP1 (COND [(NULL %C1)
	       (COND [(AND %C2 [MINUSP (%PPSIZE (CAR %L) (SUB1 (CHRCT)) T)])
		      (TAB %C2)]
		     [T (TYO 32.)])
	       (COND [(PATOM (CAR %L)) (PRIN1 (CAR %L)) (GO NEXT)])]
	      [(PATOM (CAR %L))
	       (TAB (OR %C2 [*MAX 2. (SUB1 (*DIF %C1 (FLATSIZE (CAR %L))))]))
	       (PRIN1 (CAR %L))
	       (COND [(CONSP (SETQ %L (CDR %L))) (TYO 32.) (GO LOOP1)])
	       (GO DONE)]
	      [(AND [LITATOM (CAAR %L)] [NUMBERP (GET (CAAR %L) 'COMMENT)])
	       (TYO 32.)]
	      [T (TAB %C1)])
	(%SPRINT (CAR %L) %BR)
   NEXT (SETQ %L (CDR %L))
	(GO LOOP)
   DONE (COND [%L (AND [*LESS (CHRCT) (*PLUS (FLATSIZE %L) 3.)]
		       [TAB (OR %C1 %C2)])
		  (PRINC " . ")
		  (PRIN1 %L)])))
 EXPR)

{;; Special formatting routines:⎇

(DEFPROP PP-FORMAT
 (LAMBDA (%L %N %F)
  {;; Formats the list %L with the first %N+1 elements (the function name and %N
      arguments) printed as a block.  %F specifies how the rest of the list (the
      body) will be printed: if %F=NIL (standard format) all elements will be
      printed under the first argument; if %F=LABELS all non-atomic expressions
      will be printed under the first argument with atoms placed to the left (as
      labels); if %F=MISER all elements will be printed under the function
      name.⎇
  (PROG (%C1 %C2 %RP)
	(SETQ %RP %%RP)
	(TYO %%LP)
	(SETQ %C1 (CHRPOS))
	(PRIN1 (CAR %L))
	(SETQ %C2 (ADD1 (CHRPOS)))
	(COND [(NOT (MINUSP (%PPSIZE (SETQ %L (CDR %L))
				     (*MIN (CHRCT) PPMAXLEN)
				     NIL)))
	       (PP-LSEG %L NIL NIL NIL)]
	      [T (COND [(*GREAT %N 0.)
			(PP-LSEG (SETQ %N
				       (LDIFF %L (SETQ %L (NTH (CDR %L) %N))))
				 NIL 
				 %C2 
				 NIL)]
		       [T (SETQ %N NIL)])
		 (PP-LSEG %L 
			  (COND [(EQ %F 'MISER) %C1] [T %C2])
			  (COND [(NULL %F) %C2] [(EQ %F 'MISER) %C1])
			  NIL)
		 (AND %L [FREELIST %N])])
	(TYOA %RP %C1)))
 EXPR)

(DEFPROP PP-VALUE
 (LAMBDA (%A %D %P)
  {;; Special formatter for VALUE props⎇
  (AND %A 
       [NEQ %A T]
       [PRINA (LIST 'DEFV %A (CDR %D)) (PLUS (CHRPOS) (FLATSIZE %A) 8.)]))
 EXPR)

(DEFPROP PP-RMACS
 (LAMBDA (%A %D %P)
  {;; Special formatter for READMACRO props⎇
  (SETQ %P (SETCHR %A NIL))
  (SPRINT (LIST (COND [(EQ %P 11.) 'DSM] [T 'DRM]) %A %D) 1.))
 EXPR)

(DEFPROP PP-COMMENT
 (LAMBDA (%L)
  {;; This is the comment printer.  Note that it will have to be fixed if
      AEXPLODEC is not present.⎇
  (PROG (COL WORD LSAVE)
	(AND [NULL (OUTCH)] [NULL COMMENTFLG] [RETURN (PRINC "*COMMENT*")])
	(AND [NUMBERP (SETQ COL (GET (CAR %L) 'COMMENT))] [TAB COL])
	(COND [(CDR (LAST %L)) (RETURN (PRINA %L (CHRPOS)))])
	(TYO (COND [COMMENTSTR 123.] [T 40.]))
	(PRIN1 (CAR %L))
	(SETQ COL (ADD1 (CHRPOS)))
	(COND [(OR [NOT (STRINGP (CADR %L))] [CDDR %L])
	       (TYO 32.)
	       (COND [COMMENTSTR (PRINLC (CDR %L) COL)]
		     [T (PRINL (CDR %L) COL)])
	       (GO DONE)])
	(SETQ %L (SETQ LSAVE (NCONC (AEXPLODEC (CADR %L)) (LIST 0.))))
   LOOP (SETQ WORD (MEMB 32. %L))
	(SETQ %L (PROG1 (CDR WORD) (SETQ WORD (LDIFF %L WORD))))
	(COND [(NOT (*LESS (LENGTH WORD) (CHRCT))) (TAB COL)] [T (TYO 32.)])
	(MAPC (FUNCTION
	       (LAMBDA (CH)
		(AND [NULL COMMENTSTR] [DELIM CH] [TYO 47.])
		(TYO CH)))
	      WORD)
	(AND [EQ (CAR (LAST WORD)) 46.] [NEQ (CHRCT) 0.] [TYO 32.])
	(COND [%L (FREELIST WORD) (GO LOOP)] [T (FREELIST LSAVE)])
   DONE (TYOA (COND [COMMENTSTR 125.] [T 41.]) COL)))
 EXPR)

(DEFPROP PP-MISER
 (LAMBDA (%L) (PP-FORMAT %L (OR [GET (CAR %L) 'PP-MISER] 1.) 'MISER))
 EXPR)

(DEFPROP PP-LABELS
 (LAMBDA (%L) (PP-FORMAT %L (OR [GET (CAR %L) 'PP-LABELS] 1.) 'LABELS))
 EXPR)

(DEFPROP PP-SPECIAL
 (LAMBDA (%L) (%PPSPEC %L (OR [GET (CAR %L) 'PP-SPECIAL] 1.)))
 EXPR)

(DEFPROP PP-DO
 (LAMBDA (%L)
  (%PPSPEC %L 
	   (COND [(ATOM (CDR %L)) 0.]
		 [T (SELECTQ [CADR %L] [(WHILE UNTIL) 2.] [FOR 4.] 0.)])))
 EXPR)

(DEFPROP %PPSPEC
 (LAMBDA (%L %N)
  (PP-FORMAT %L 
	     %N 
	     (AND [*GREAT (*TIMES 6. (%DEPTH %L))
			  (*DIF (CHRCT) (FLATSIZE (CAR %L)))]
		  'MISER)))
 EXPR)

(DEFLIST (DEFPROP LAMBDA FUNCTION *FUNCTION) PP-MISER PRINTMACRO)

(DEFLIST (FUNCTION *FUNCTION) 0. PP-MISER)

(DEFLIST (PROG) PP-LABELS PRINTMACRO)

(DEFLIST (DEFP DEFV SETQ DRM DSM DE DF DM DV F:L RPTQ PUSH)
	 PP-SPECIAL 
	 PRINTMACRO)

(DEFLIST (DE DF DM) 2. PP-SPECIAL)

(DEFPROP DO PP-DO PRINTMACRO)

(DEFLIST (COND AND OR SELECTQ CATCH) BRACKETS PRINTMACRO)

(DEFPROP QUOTE "'" PRINTMACRO)

(DEFPROP ; PP-COMMENT PRINTMACRO)

(DEFPROP ;; PP-COMMENT PRINTMACRO)

(DEFPROP ; 40. COMMENT)

(DEFPROP ;; T COMMENT)

(DEFV PRETTYFLG T)

(DEFV COMMENTFLG NIL)

(DEFV COMMENTSTR T)

(DEFV PRETTYPROPS (SPECIAL (READMACRO . PP-RMACS) EXPR FEXPR MACRO 
		   (VALUE . PP-VALUE) PRINTMACRO))

{;; In case someone gets cute and calls %SPRINT or PP-FORMAT directly instead of
    going thru SPRINT:⎇

(PROGN (SETQ %%LL (LINELENGTH NIL)) (SETQ %%LP 40.) (SETQ %%RP 41.))

{;; Set up names for GRINers:⎇

(PROGN (DEFP GRINDEF PP (FEXPR FSUBR))
       (DEFP GRINL PPL (FEXPR FSUBR))
       (REMPROP 'GRINPROPS 'VALUE)
       (DEFP GRINPROPS PRETTYPROPS VALUE))

(NOCOMPILE
(DEFV PPFNS ((DECLARE (SPECIAL PP PRETTYPROPS NOPRETTYPROPS PRETTYFLG 
	     COMMENTFLG COMMENTSTR PPMAXLEN %%LL %%BR %%CC %%T %%LP %%RP 
	     LASTWORD EDITV INTERNSTR) (NOCALL %SPRINT %DEPTH %PPSIZE %PPSPEC 
	     %%LL %%BR %%CC %%T %%LP %%RP)) (DEFP ; NILL FSUBR) (DEFP ;; NILL 
	     FSUBR) /{ (;; 
	     "(This comment has to follow the above definition). If your READLIS→
T doesn't allow ASCII values, the above readmacro and PP-COMMENT will have to be→
 modified.") (;; "Top level functions:") (F: PPL PPL; PP (V: (PP NIL) 
	     (NOPRETTYPROPS T)) PP;) (;; "PPCOM command functions:") 
	     (F: *PG* F: P: V: MBD: FORMS: (DEFP E: PROGN FSUBR) (DEFLIST 
	     (*PG* F: P: V: MBD: FORMS: E:) T PPCOM)) (;; 
	     "SPRINT and friends:") (F: SPRINT %SPRINT (V: PPMAXLEN) %DEPTH 
	     %PPSIZE PP-LSEG) (;; "Special formatting routines:") (F: 
	     PP-FORMAT PP-VALUE PP-RMACS PP-COMMENT PP-MISER PP-LABELS 
	     PP-SPECIAL PP-DO %PPSPEC) (DEFLIST (DEFPROP LAMBDA FUNCTION 
	     *FUNCTION) PP-MISER PRINTMACRO) (DEFLIST (FUNCTION *FUNCTION) 0. 
	     PP-MISER) (DEFLIST (PROG) PP-LABELS PRINTMACRO) (DEFLIST 
	     (DEFP DEFV SETQ DRM DSM DE DF DM DV F:L RPTQ PUSH) PP-SPECIAL 
	     PRINTMACRO) (DEFLIST (DE DF DM) 2. PP-SPECIAL) (P: (PRINTMACRO) 
	     DO) (DEFLIST (COND AND OR SELECTQ CATCH) BRACKETS PRINTMACRO) 
	     (P: (PRINTMACRO) QUOTE ; ;;) (P: (COMMENT) ; ;;) (V: (PRETTYFLG 
	     T) (COMMENTFLG NIL) COMMENTSTR PRETTYPROPS) (;; 
	     "In case someone gets cute and calls %SPRINT or PP-FORMAT directly →
instead of going thru SPRINT:") (PROGN (SETQ %%LL (LINELENGTH NIL)) 
	     (SETQ %%LP 40.) (SETQ %%RP 41.)) (;; "Set up names for GRINers:") 
	     (PROGN (DEFP GRINDEF PP (FEXPR FSUBR)) (DEFP GRINL PPL 
	     (FEXPR FSUBR)) (REMPROP (QUOTE GRINPROPS) (QUOTE VALUE)) 
	     (DEFP GRINPROPS PRETTYPROPS VALUE))))
)